home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / smtlbox / frmmain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-01  |  11.6 KB  |  362 lines
  1. VERSION 2.00
  2. Begin Form frmMain 
  3.    BackColor       =   &H00FFFFFF&
  4.    BorderStyle     =   0  'None
  5.    ClientHeight    =   3855
  6.    ClientLeft      =   1095
  7.    ClientTop       =   1380
  8.    ClientWidth     =   4680
  9.    ControlBox      =   0   'False
  10.    Height          =   4260
  11.    KeyPreview      =   -1  'True
  12.    Left            =   1035
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   257
  17.    ScaleMode       =   3  'Pixel
  18.    ScaleWidth      =   312
  19.    Top             =   1035
  20.    Width           =   4800
  21.    Begin Timer Timer1 
  22.       Left            =   1500
  23.       Top             =   1650
  24.    End
  25.    Begin PictureBox picControlMenu 
  26.       Height          =   150
  27.       Left            =   60
  28.       ScaleHeight     =   120
  29.       ScaleWidth      =   150
  30.       TabIndex        =   1
  31.       Top             =   210
  32.       Width           =   180
  33.    End
  34.    Begin Shape WindowBorder2 
  35.       DrawMode        =   1  'Blackness
  36.       Height          =   135
  37.       Left            =   1980
  38.       Top             =   750
  39.       Width           =   1215
  40.    End
  41.    Begin Image Image1 
  42.       Height          =   120
  43.       Index           =   0
  44.       Left            =   0
  45.       Top             =   0
  46.       Visible         =   0   'False
  47.       Width           =   150
  48.    End
  49.    Begin Image Image1 
  50.       BorderStyle     =   1  'Fixed Single
  51.       Height          =   150
  52.       Index           =   1
  53.       Left            =   60
  54.       Top             =   210
  55.       Visible         =   0   'False
  56.       Width           =   180
  57.    End
  58.    Begin Shape WindowBorder1 
  59.       BorderWidth     =   2
  60.       Height          =   525
  61.       Left            =   3060
  62.       Top             =   3930
  63.       Width           =   1215
  64.    End
  65.    Begin Label TitleBarObject 
  66.       Alignment       =   2  'Center
  67.       BackColor       =   &H80000002&
  68.       BorderStyle     =   1  'Fixed Single
  69.       Height          =   160
  70.       Left            =   0
  71.       TabIndex        =   0
  72.       Top             =   0
  73.       Width           =   7395
  74.    End
  75. 'General Declarations
  76. Const WM_NCLBUTTONDOWN = &HA1
  77. Const HTCAPTION = 2
  78. Declare Function Sendmessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  79. Declare Sub ReleaseCapture Lib "User" ()
  80. Declare Function GetactiveWindow Lib "User" () As Integer
  81. Dim Focus As Integer
  82. '//////////////////////////////////////////////////
  83. ' WINDOWBUILD
  84. '//////////////////////////////////////////////////
  85. Sub Form_GotFocus ()
  86. TitleBarObject.BackColor = active_Title_BAr
  87. '//////////////////////////////////////////////////
  88.         'Events for this object:
  89.          'Load
  90.          'Unload
  91.          'Gotfocus
  92.          'LostFocus
  93.          'MouseDown
  94.          'MouseUp
  95.          'DblClick
  96.          'KeyDown
  97.          'Resize
  98. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  99. End Sub
  100. Sub Form_KeyDown (KEYCODE As Integer, Shift As Integer)
  101. '//////////////////////////////////////////////////
  102.         'Events for this object:
  103.          'Load
  104.          'Unload
  105.          'Gotfocus
  106.          'LostFocus
  107.          'MouseDown
  108.          'MouseUp
  109.          'DblClick
  110.          'KeyDown
  111.          'Resize
  112. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  113. Dim ShiftDown, Altdown, CtrlDown
  114.    Const KEY_F4 = &H73
  115.     'Const KEY_F2 = &H71 ' Define constants.
  116.     Const ALT_MASK = 4
  117.     Altdown = (Shift And ALT_MASK) > 0
  118.     If KEYCODE = KEY_sPACE Then    ' Display key combinations.
  119.     If ShiftDown And CtrlDown And Altdown Then
  120.     ElseIf ShiftDown And Altdown Then
  121.     ElseIf ShiftDown And CtrlDown Then
  122.     ElseIf CtrlDown And Altdown Then
  123.     ElseIf ShiftDown Then
  124.     ElseIf CtrlDown Then
  125.      
  126.     ElseIf Altdown Then
  127.     picControlMenu_Mouseup 1, 0, 0, 0
  128.     ElseIf Shift = 0 Then
  129.     End If
  130.     End If
  131.     If KEYCODE = KEY_F4 Then
  132.     If Altdown Then
  133.     End
  134.     End If
  135.     End If
  136. '//////////////////////////////////////////////////
  137.         'Events for this object:
  138.          'Load
  139.          'Unload
  140.          'Gotfocus
  141.          'LostFocus
  142.          'MouseDown
  143.          'MouseUp
  144.          'DblClick
  145.          'KeyDown
  146.          'Resize
  147. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  148. End Sub
  149. Sub Form_Load ()
  150.     Call WindowBuild(frmMain, WindowBorder1, TitleBarObject, picControlMenu)
  151.     ' Pass it the names of the objects that make up the Window.' Call WindowBuild a second time to eliminate flicker
  152.         Call WindowBuild(frmMain, WindowBorder2, TitleBarObject, picControlMenu)
  153.             Focus = True 'To color the window approprietly
  154.                 Timer1.Interval = 10 'Enable timer to catch events
  155. ' Code for "INI" File
  156.    ' frmMain.Top = GetPrivateProfileInt(SECTION, "Top", 0, INIFILENAME)
  157.    ' frmMain.Left = GetPrivateProfileInt(SECTION, "Left", 0, INIFILENAME)
  158.    ' frmMain.Height = GetPrivateProfileInt(SECTION, "Height", Screen.Height, INIFILENAME)
  159.    ' frmMain.Width = GetPrivateProfileInt(SECTION, "Width", Screen.Width, INIFILENAME)
  160. '//////////////////////////////////////////////////
  161.         'Events for this object:
  162.          'Load
  163.          'Unload
  164.          'Gotfocus
  165.          'LostFocus
  166.          'MouseDown
  167.          'MouseUp
  168.          'DblClick
  169.          'KeyDown
  170.          'Resize
  171. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  172.         End Sub
  173. Sub Form_LostFocus ()
  174. Dim i As Integer
  175. i = GetactiveWindow()
  176. MsgBox "" + Str$(i)
  177. '//////////////////////////////////////////////////
  178.         'Events for this object:
  179.          'Load
  180.          'Unload
  181.          'Gotfocus
  182.          'LostFocus
  183.          'MouseDown
  184.          'MouseUp
  185.          'DblClick
  186.          'KeyDown
  187.          'Resize
  188. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  189. End Sub
  190. Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  191. If Focus = True Then
  192.     TitleBarObject.BackColor = active_Title_BAr
  193.     TitleBarObject.BackColor = active_Title_BAr
  194. End If
  195. '//////////////////////////////////////////////////
  196.         'Events for this object:
  197.          'Load
  198.          'Unload
  199.          'Gotfocus
  200.          'LostFocus
  201.          'MouseDown
  202.          'MouseUp
  203.          'DblClick
  204.          'KeyDown
  205.          'Resize
  206. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  207. End Sub
  208. Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  209. Focus = True
  210. Timer1.Interval = 10
  211. '//////////////////////////////////////////////////
  212.         'Events for this object:
  213.          'Load
  214.          'Unload
  215.          'Gotfocus
  216.          'LostFocus
  217.          'MouseDown
  218.          'MouseUp
  219.          'DblClick
  220.          'KeyDown
  221.          'Resize
  222. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  223. End Sub
  224. Sub Form_Resize ()
  225. WindowBuild frmMain, WindowBorder1, TitleBarObject, picControlMenu
  226. WindowBuild frmMain, WindowBorder2, TitleBarObject, picControlMenu
  227. '//////////////////////////////////////////////////
  228.         'Events for this object:
  229.          'Load
  230.          'Unload
  231.          'Gotfocus
  232.          'LostFocus
  233.          'MouseDown
  234.          'MouseUp
  235.          'DblClick
  236.          'KeyDown
  237.          'Resize
  238. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  239. End Sub
  240. Sub Form_Unload (Cancel As Integer)
  241.     Dim rc As Integer
  242.     'Create the INI file
  243.     rc = WritePrivateProfileString(SECTION, ByVal "Top", ByVal Str$(frmMain.Top), INIFILENAME)
  244.     rc = WritePrivateProfileString(SECTION, ByVal "Left", ByVal Str$(frmMain.Left), INIFILENAME)
  245.     rc = WritePrivateProfileString(SECTION, ByVal "Height", ByVal Str$(frmMain.Height), INIFILENAME)
  246.     rc = WritePrivateProfileString(SECTION, ByVal "Width", ByVal Str$(frmMain.Width), INIFILENAME)
  247.     'Terminate the application
  248.     End
  249. '//////////////////////////////////////////////////
  250.         'Events for this object:
  251.          'Load
  252.          'Unload
  253.          'Gotfocus
  254.          'LostFocus
  255.          'MouseDown
  256.          'MouseUp
  257.          'DblClick
  258.          'KeyDown
  259.          'Resize
  260. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  261. End Sub
  262. Sub picControlMenu_DblClick ()
  263. Unload frmMain
  264. '//////////////////////////////////////////////////
  265.         'Events for this object:
  266.          'DblClick
  267.          'MouseDown
  268.          'MouseUp
  269.          'Resize
  270. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  271. End Sub
  272. Sub picControlMenu_Mousedown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  273. Focus = True
  274. Timer1.Interval = 10
  275. '//////////////////////////////////////////////////
  276.         'Events for this object:
  277.          'DblClick
  278.          'MouseDown
  279.          'MouseUp
  280.          'Resize
  281. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  282. End Sub
  283. Sub picControlMenu_Mouseup (Button As Integer, Shift As Integer, X As Single, Y As Single)
  284. TitleBarObject.BackColor = active_Title_BAr
  285. mousepointer = 5
  286. Focus = True
  287. Timer1.Interval = 10
  288. PopupMenu frmDummy.mnuSystemMenu, 0, 0, 9
  289. mousepointer = 0
  290. '//////////////////////////////////////////////////
  291.         'Events for this object:
  292.          'DblClick
  293.          'MouseDown
  294.          'MouseUp
  295.          'Resize
  296. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  297. End Sub
  298. Sub picControlMenu_Resize ()
  299. picControlMenu.Picture = Image1(1).Picture
  300. '//////////////////////////////////////////////////
  301.         'Events for this object:
  302.          'DblClick
  303.          'MouseDown
  304.          'MouseUp
  305.          'Resize
  306. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  307. End Sub
  308. Sub Timer1_Timer ()
  309.    If Focus = True Then
  310.     If GetactiveWindow() <> frmMain.hWnd Then
  311.        'Do form's lost-focus routines here.
  312.        Focus = False
  313.        WindowBorder1.BorderColor = Inactive_Border
  314.        TitleBarObject.BackColor = inactive_Title_BAr
  315.     Else
  316.       Focus = True
  317.     End If
  318.    End If
  319. 'Only Event for this object
  320. '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  321. End Sub
  322. Sub TitleBarObject_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  323. Focus = True
  324.     Timer1.Interval = 10
  325.     If Button <> 1 Then Exit Sub ' If not the left mouse button, ...exit
  326.     Dim ReturnVal%
  327.     ReleaseCapture
  328.     ReturnVal% = Sendmessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
  329.     Dim i As Integer
  330.     i = GetactiveWindow()
  331. TitleBarObject.BackColor = active_Title_BAr
  332. '//////////////////////////////////////////////////
  333. 'Only Event for this object
  334. '//////////////////////////////////////////////////
  335. End Sub
  336. Sub WindowBuild (Frm As Form, WindowBorder As Shape, TitleBar As Label, ControlMenu As PictureBox)
  337.     ControlMenu.Top = 0     'Places the menu "|-|" picture
  338.     ControlMenu.Left = 0    'in the UpperLeft
  339. '*****************Create a border for the window******************
  340.     WindowBorder.Width = Frm.ScaleWidth
  341.     WindowBorder.Height = Frm.ScaleHeight
  342.     WindowBorder.Left = 0
  343.     WindowBorder.Top = 0
  344. Rem******Other effects can be added with the' WindowBorder.BorderWidth property
  345. Rem******This will create a shadow effect*******************************************
  346. Rem*WindowBorder.BorderWidth = 3; WindowBorder.Left = -1; WindowBorder.Top = -1
  347. TitleBar.Width = Frm.ScaleWidth + 1 ' Makes the title bar 1 pixel larger than the width of the form
  348. Rem Change this to adjust the height of the titlebar.*
  349. '*******************************************************
  350. TitleBar.Height = 12 '
  351. '*******************************************************
  352. 'Note:  You must make a custom BMP for the Control Menu,
  353. '       if you change this.
  354.   Dim offset As Integer
  355.     offset = 2
  356.     ControlMenu.Height = TitleBar.Height - offset
  357.     ControlMenu.Width = TitleBar.Height
  358.         
  359.         TitleBar.Left = -offset
  360.         TitleBar.Top = -offset
  361. End Sub
  362.